%% -*- coding: utf-8 -*-

%% @doc 式言語パース時のハンドラ
%%
-module(templel_parse_handler).
-export([lor/2,land/2,equal/2,not_equal/2,lt/2,leq/2,gt/2,geq/2]).
-export([add/2,sub/2,mul/2,divide/2,negate/1,minus/1]).
-export([get_by_key/1,get_by_key/2,get_by_index/2,call/3,args/1]).

-define(CL1(Fun, Arg), fun(VT) -> Fun(Arg(VT)) end).

gen_cl2(Fun, Arg1, Arg2) when is_function(Arg1), is_function(Arg2) ->
	fun(VT) -> Fun(Arg1(VT), Arg2(VT)) end;
gen_cl2(Fun, Arg1, Arg2) when is_function(Arg1) ->
	fun(VT) -> Fun(Arg1(VT), Arg2) end;
gen_cl2(Fun, Arg1, Arg2) when is_function(Arg2) ->
	fun(VT) -> Fun(Arg1, Arg2(VT)) end.


%% @spec get_by_key(string()|{name,any(),string()}) -> term()
%%
get_by_key({name,_,Key}) ->
	fun(VT) -> 
			case templ_env:get_by_key(VT, Key) of
				{ok,Value} -> {value,Key,eval_value(Value)};
				error      -> erlang:error({novalue,Key})
			end
	end.

%% @spec get_by_key(context(), string()|{name,any(),string()}) -> term()
%%
get_by_key(Fun, Name) when is_function(Fun) ->
	fun(VT) -> get_by_key(Fun(VT), Name) end;
get_by_key({_,_,VT={dict,_,_,_,_,_,_,_,_}}, {name,_,Key}) ->
	case (templ_env:get_by_key(VT, Key)) of
		{ok,Value} -> {value,Key,eval_value(Value)};
		error      -> erlang:error({novalue,Key})
	end;
get_by_key(Val, {name,_,BIPName}) ->
	built_in_property(BIPName, Val);
get_by_key(Val, {integer,_,Idx}) ->
	get_by_index(Val, Idx);
get_by_key(Val, Name) ->
	throw({{?MODULE,einval},{Val,Name}}).


eval_value(Value=[E|_]) -> % TODO: プロパティリストのチェック
	case is_tuple(E) of
		true -> templ_env:init_vtable(Value);
		false -> Value
	end;
eval_value(Value) -> Value.
	

get_by_index({_,Name,Val}, Idx) when is_list(Val) ->
	try lists:nth(Idx, Val) of
		Elem ->
			{nth,Name,Elem}
	catch
		error:function_clause -> % 境界エラー
			throw({{?MODULE,einval},{Name,Val},"out of bound"})
	end;
get_by_index(Fun, Idx) when is_function(Fun) ->
	fun(VT) -> get_by_index(Fun(VT), Idx) end;
get_by_index(Fun, Idx) ->
	throw({{?MODULE,einval},{Fun,Idx}}).


built_in_property("first", {_,Name,_Val}) ->
	{first,none,templ_env:is_first(Name)};
built_in_property("last", {_,Name,_Val}) ->
	{last,none,templ_env:is_last(Name)};
built_in_property("nth", {_,Name,_Val}) ->
	{nth,none,templ_env:nth(Name)};
built_in_property(Name, Var) ->
	throw({{?MODULE,einval},{Name,Var},"undefined property"}).


negate(B) when is_boolean(B) ->
	not(B);
negate(B) when is_function(B) ->
	?CL1(fun negate/1, B);
negate(B) ->
	throw({{?MODULE,einval},B}).

minus(I) when is_integer(I) ->
	-I;
minus(I) when is_function(I) ->
	?CL1(fun minus/1, I);
minus(I) ->
	throw({{?MODULE,einval},I}).


add(I1, I2) when is_integer(I1), is_integer(I2) ->
	I1 + I2;
add(I1, I2) when is_function(I1); is_function(I2) ->
	gen_cl2(fun add/2, I1, I2);
add(I1, I2) ->
	throw({{?MODULE,einval},{I1,I2}}).
sub(I1, I2) when is_integer(I1), is_integer(I2) ->
	I1 - I2;
sub(I1, I2) when is_function(I1); is_function(I2) ->
	gen_cl2(fun sub/2, I1, I2);
sub(I1, I2) ->
	throw({{?MODULE,einval},{I1,I2}}).
mul(I1, I2) when is_integer(I1), is_integer(I2) ->
	I1 * I2;
mul(I1, I2) when is_function(I1); is_function(I2) ->
	gen_cl2(fun mul/2, I1, I2);
mul(I1, I2) ->
	throw({{?MODULE,einval},{I1,I2}}).
divide(I1, I2) when is_integer(I1), is_integer(I2) ->
	I1 / I2;
divide(I1, I2) when is_function(I1); is_function(I2) ->
	gen_cl2(fun divide/2, I1, I2);
divide(I1, I2) ->
	throw({{?MODULE,einval},{I1,I2}}).

equal(true, true) -> true;
equal(false, false) -> true;
%
equal(I1, I2)
  when is_integer(I1), is_integer(I2) ->
  	if
		I1 =:= I2 -> true;
		true -> false
	end;
%
equal(B1, E2) when is_binary(B1) ->
	equal(binary_to_list(B1), E2);
equal(E1, B2) when is_binary(B2) ->
	equal(E1, binary_to_list(B2));
%
equal([C1|Cs1], [C2|Cs2]) when C1 =:= C2 ->
    equal(Cs1, Cs2);
equal([], []) -> true;
%
equal(I1, I2) when is_function(I1); is_function(I2) ->
	gen_cl2(fun equal/2, I1, I2);
equal(_Expr1, _Expr2) -> false.

not_equal(E1, E2) when is_function(E1); is_function(E2) ->
	fun(VT) -> not((equal(E1, E2))(VT)) end;
not_equal(E1, E2) ->
	not(equal(E1, E2)).

lt(I1, I2) when is_integer(I1), is_integer(I2) ->
	I1 < I2;
lt(I1, I2) when is_function(I1); is_function(I2) ->
	gen_cl2(fun lt/2, I1, I2);
lt(I1, I2) ->
	throw({{?MODULE,einval},{I1,I2}}).
leq(I1, I2) when is_integer(I1), is_integer(I2) ->
	I1 =< I2;
leq(I1, I2) when is_function(I1); is_function(I2) ->
	gen_cl2(fun leq/2, I1, I2);
leq(I1, I2) ->
	throw({{?MODULE,einval},{I1,I2}}).
gt(I1, I2) when is_integer(I1), is_integer(I2) ->
	I1 > I2;
gt(I1, I2) when is_function(I1); is_function(I2) ->
	gen_cl2(fun gt/2, I1, I2);
gt(I1, I2) ->
	throw({{?MODULE,einval},{I1,I2}}).
geq(I1, I2) when is_integer(I1), is_integer(I2) ->
	I1 >= I2;
geq(I1, I2) when is_function(I1); is_function(I2) ->
	gen_cl2(fun geq/2, I1, I2);
geq(I1, I2) ->
	throw({{?MODULE,einval},{I1,I2}}).

land(B1, B2) when is_boolean(B1), is_boolean(B2) ->
  	if
		B1, B2 -> true;
		true -> false
	end;
land(I1, I2) when is_function(I1); is_function(I2) ->
	gen_cl2(fun land/2, I1, I2);
land(I1, I2) ->
	throw({{?MODULE,einval},{I1,I2}}).
lor(B1, B2) when is_boolean(B1), is_boolean(B2) ->
  	if
		B1; B2 -> true;
		true -> false
	end;
lor(I1, I2) when is_function(I1); is_function(I2) ->
	gen_cl2(fun lor/2, I1, I2);
lor(I1, I2) ->
	throw({{?MODULE,einval},{I1,I2}}).


call({name,_,Mod}, {name,_,Fun}, Args) ->
	fun(VT) -> apply(list_to_atom(Mod), list_to_atom(Fun), Args(VT)) end;
call({_,_,Mod}, {_,_,Fun}, Args) ->
	fun(VT) -> apply(Mod, Fun, Args(VT)) end;
call(Mod, Fun, Args) ->
	fun(VT) -> ((gen_cl2(fun(M, F) -> call(M, F, Args) end, Mod, Fun))(VT))(VT) end.

args(Args) ->
	fun(VT) -> lists:map(fun(Arg) -> 
								 case is_function(Arg) of
									 true  -> Arg(VT);
									 false -> Arg
								 end end,
						 Args) end.

